This document illustrate how we can improve ShinyApp Style, and performance. The assignment consists of developing a shiny app that tracks encounter animals and plants species in the world. The dataset comes from two csv large files (4G, 2.4G) which are can not open with an ordinary computer.
To demonstrate how we can improve recativities and play around skilling shiny app, We will walk through survey sections and try to site concrete example.
library(remotes)
library(tictoc)
library(RSQLite)
library(tidyverse)
library(geojson)
library(geojsonio)
library(data.table)
library(profvis)The app is a full R package that responds to CRAN/Bioconductor criteria. It is named biodiversity. It uses a map with multiple layers. The species are marked with different color in the map. User can view/hide any kingdom, search any species using keywords and the app return matched species and focus on select one.
To install and run biodiversity shiny app, just run these code
Screenshot of biodiversity
As we said, the dataset is two csv files with about 6.5G. The first option to deal with this, is to convert the csv files to sqlite database for example.
In reality, using DB instead csv file is not enought to scale the App to 1000s of users. It is importante use Faster function, like here:
apply family versus loopingcon <- DBI::dbConnect(RSQLite::SQLite(), "../../../DATA/Concours/Appsilon/biodiversity/biodiversity/inst/biodiversity/extdata/biodiversity.db")
countries_list <- NULL
tic(msg = "### LOOPING PROCESS ###")
for (i in DBI::dbListTables(con)){
countries_list[[i]] <- tbl(con,i) %>% as_tibble()
}
toc()## ### LOOPING PROCESS ###: 4.442 sec elapsed
countries_list <- NULL
tic(msg = "### LAPPLY PROCESS ###")
countries_list <- lapply(DBI::dbListTables(con), function(x) tbl(con,x) %>% as_tibble)
toc()## ### LAPPLY PROCESS ###: 3.061 sec elapsed
In general it is better to use apply family function instead looping.
In our case, we need to load geo.json file map. Mainly, this kid of files have a metadata that can to become heavier. Here, we compared to file with different metadata countain. The first one is heavy and located at /extdata folder, and the other loaded directly from the url source.
## Load Map SLOW
tic(msg = "### From File ###")
countries_map <- geojson_read("../../../DATA/Concours/Appsilon/countries.geojson", what = "sp")
toc()## ### From File ###: 4.246 sec elapsed
## Load map FASTER
tic(msg = "### From link ###")
countries_map <- geojson_read("https://raw.githubusercontent.com/johan/world.geo.json/master/countries.geo.json", what = "sp")
toc()## ### From link ###: 0.668 sec elapsed
Nice! In the next steps we will improve the map loading by Caching.
set.seed(34)
countries <- c("Poland", "Switzerland")
tic("#### USING grepl ###")
biodiversity_data<- countries_list %>%
rbindlist() %>%
filter(grepl(paste0(countries, collapse = "|"), country, ignore.case = TRUE))
toc()## #### USING grepl ###: 1.522 sec elapsed
tic("### USING %in% ###")
biodiversity_data <- countries_list %>%
rbindlist() %>%
filter( country %in% countries )
toc()## ### USING %in% ###: 0.989 sec elapsed
tic("### USING str_detect ###")
biodiversity_data <- countries_list %>%
rbindlist() %>%
filter( str_detect(country, countries))
toc()## ### USING str_detect ###: 1.381 sec elapsed
While adding countries to the database, the app become slow, mainly during ploting the map. The bottleneck become bigger when there are more circles markers (encounters) to plot on the map.
We will use profvis package to screen when the code takes a lot of memory.
## Loading required package: shiny
##
## Attaching package: 'shiny'
## The following object is masked from 'package:geojsonio':
##
## validate
## sourcing frontPage: 0.235 sec elapsed
## sourcing frontPage_ui: 0.006 sec elapsed
## [1] "NEW QUERY OF: Poland"
## Loading Map for Poland: 0.27 sec elapsed
## Loading Table of Poland: 0.229 sec elapsed
## data Processing of Poland: 0.734 sec elapsed
## Building the Map of Poland: 0.813 sec elapsed
## [1] "NEW QUERY OF: Poland"
## Loading Map for Poland: 0.281 sec elapsed
## Loading Table of Poland: 0.215 sec elapsed
## data Processing of Poland: 0.667 sec elapsed
## Building the Map of Poland: 0.869 sec elapsed
## [1] "The biodiversity App is closed."
It is clear that the rendering leaflet map takes more time than the other process.
User can select a country to focus on and search for species. When the user wants to iterate the choice of the country, a popup appears and wait for input country. Here we can catch previous plot and wait if the user/users (session/application level) reselect the same country, then the app can return it without computing.
bindCache() of renderleaflet()vals <- reactiveValues(countries = NULL)
## Listening OK button
observeEvent(input$ok, {
if (!is.null(input$countries_id) && nzchar(input$countries_id)) {
vals$countries <- input$countries_id
removeModal()
} else {
showModal(popupModal(failed = TRUE))
}
})
output$worldMap <- renderLeaflet({
...
for (i in input$countries_id){
#Put each table in the list, one by one
table_list[[i]] <- tbl(con,i) %>% as_tibble()
...
}
}) %>% bindCache(vals$countries, cache = "session")Note
Adding %>% bindCache(vals$countries, cache = "session") the app save data loading, processig and renderplot if the user reselect the same country. In the other hand, we do not view progress bar for loading, preprocessing and ploting. It is a caching at session level.
We can generalize the cache at the application level and memorize the object for multiple user by setting %>% bindCache(vals$countries, cache = "app").
## sourcing frontPage: 0.132 sec elapsed
## sourcing frontPage_ui: 0.209 sec elapsed
## [1] "NEW QUERY OF: Poland"
## Loading Map for Poland: 0.257 sec elapsed
## Loading Table of Poland: 0.194 sec elapsed
## data Processing of Poland: 0.646 sec elapsed
## Building the Map of Poland: 0.687 sec elapsed
## [1] "NEW QUERY OF: Poland"
## [1] "NEW QUERY OF: Switzerland"
## Loading Map for Switzerland: 0.259 sec elapsed
## Loading Table of Switzerland: 0.418 sec elapsed
## data Processing of Switzerland: 1.68 sec elapsed
## Building the Map of Switzerland: 1.618 sec elapsed
## [1] "NEW QUERY OF: Switzerland"
## [1] "NEW QUERY OF: Poland"
## [1] "The biodiversity App is closed."
Steps of this demo: Query Poland, Poland, Switzerland, Switzerland, Poland.
Only the first query on each country has computing steps.
You can see the Loading Map… is done for Poland and Switzerland which is not necessary. In the next step, we will cache it by memoise.
Memoise functionsThe same result can be obtained by using memoise function. Here we will generate a BAD function inside renderLeaflet just to see how it works.
output$worldMap <- renderLeaflet({
leaflet_fun <- function(countries_id){
...
for (i in input$countries_id){
#Put each table in the list, one by one
table_list[[i]] <- tbl(con,i) %>% as_tibble()
...
}
}
## memorize at the session level
m_leaflet_fun <- memoise::memoise(leaflet_fun, cache = session$cache)
})
m_leaflet_fun(input$countries_id)Note
The argument used in memorize function is the input country (selected country). In this case, all processing will run only if a new country was selected by user. In the other hand, like in previous example bindCache(), each country will be proceed only the first time.
## sourcing frontPage: 0.048 sec elapsed
## sourcing frontPage_ui: 0.004 sec elapsed
## [1] "NEW QUERY OF: Poland"
## Loading Map for Poland: 0.261 sec elapsed
## Loading Table of Poland: 0.185 sec elapsed
## data Processing of Poland: 0.694 sec elapsed
## Building the Map of Poland: 1.125 sec elapsed
## [1] "NEW QUERY OF: Poland"
## [1] "NEW QUERY OF: Switzerland"
## Loading Map for Switzerland: 0.001 sec elapsed
## Loading Table of Switzerland: 0.425 sec elapsed
## data Processing of Switzerland: 1.383 sec elapsed
## Building the Map of Switzerland: 1.949 sec elapsed
## [1] "NEW QUERY OF: Switzerland"
## [1] "NEW QUERY OF: Poland"
## [1] "The biodiversity App is closed."
Steps: Query Poland, Poland, Switzerland, Switzerland, Poland.
Only the first query on each country has computing steps.
To memoize the process at Application level we need to change the argument by , m_leaflet_fun <- memoise::memoise(leaflet_fun, cache = getShinyOption("cache"))
Reading geojson map takes a while to load. And, it is reloaded in each country which is not necessary. To memoize the map we can do this:
geojson_read_fun <- function(url){
withProgress(message = 'Loading Map ...', value = 20, {
## Load Map source : https://datahub.io/core/geo-countries#r
#countries_map <- geojson_read("extdata/countries.geojson", what = "sp")
## Load map Faster
geojson_read(url, what = "sp")
})
}
m_geojson_read_fun <- memoise::memoise(geojson_read_fun, cache = session$cache) tic(paste0("Loading Map for ", countries_id))
countries_map <- m_geojson_read_fun("https://raw.githubusercontent.com/johan/world.geo.json/master/countries.geo.json")
toc()Note
If you an see in the last run of biodiversityMemoise::biodiversityMemoise(), the Loading Map… was consumed time only the first query. The following query have elapsed time 0s.
Here an example of how we can play with css and js files to improve the beauty of Shiny App. Also we can add beauty documentation using markdown or Rmarkdown.
shinyUI(fluidPage(theme = shinytheme("flatly"), title = "Biodiversity", #superhero, flatly
# Add CSS files
includeCSS(path = "www/AdminLTE.css"),
includeCSS(path = "www/shinydashboard.css"),
tags$head(includeCSS("www/styles.css")),
## Include Appsilon logo at the right of the navbarPage
tags$head(tags$script(type="text/javascript", src = "logo.js" )),
## Include Biodirsity logo
navbarPage(title=div(img(src="biodiversity.png", height = "50px", widht = "50px",
style = "position: relative; top: -14px; right: 1px;"),
"Biodiversity"),
tabPanel("Globe",icon = icon('globe'),
div(class="outer",
tags$head(includeCSS("www/styles.css")),
uiOutput('ui_frontPage')
)),
navbarMenu("", icon = icon("question-circle"),
tabPanel("About",icon = icon("info"),
withMathJax(includeMarkdown("extdata/help/about.md"))
#includeHTML("README.html")
),
tabPanel("Performance",icon = icon("creative-commons-sampling"),
withMathJax(includeMarkdown("extdata/help/performance.md"))
#includeHTML("README.html")
),
tabPanel("Help", icon = icon("question"),
withMathJax(includeMarkdown("extdata/help/help.md"))), #uiOutput("help_ui")
tabPanel(tags$a(
"", href = "https://github.com/kmezhoud/biodiversity/issues", target = "_blank",
list(icon("github"), "Report issue")
)),
tabPanel(tags$a(
"", href = "https://github.com/kmezhoud/biodiversity", target = "_blank",
list(icon("globe"), "Resources")
))
)
)
))We can add a transparent layer with button, collapsable table and plotly. Like this piece of code to generate transparent panel with button over the Map:
column(width = 12,#style='height:200px',
div(class="outer",
tags$head(includeCSS("www/styles.css")),
leafletOutput("worldMap", height = "600px"),
absolutePanel(id = "panel_id", class = "panel panel-default",
top = 300, left = 20, width = 45, fixed=FALSE,
draggable = TRUE, height = 45 ,#"auto",
# Make the absolutePanla collapsable
#HTML('<button data-toggle="collapse" data-target="#popup_id">Country</button> '),
#tags$div(id = 'popup_id', class="collapse",#style='background-color:transparent; border-color: transparent',
div(actionButton(inputId = "popup_id",label = "",
icon = icon("globe"),
style='background-color:transparent; border-color: transparent',),
style = "font-size:100%")
#)
),
)
)